Gigarom 1/Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso/FILES/DEV/I-Z/TransSkel.cpt/EventLog.pas

Pascal/Delphi Source File | 1987-01-11 | 19KB | 902 lines

{    EventLog - TransDisplay event-logging demonstration program}

{    The project should include EventLog.c (this file), TransDisplay.c}
{    (or a project made from TransDisplay.c), TransSkel.c (or a project}
{    made from TransSkel.c), and MacTraps.}

{    8 November 1986    Paul DuBois}

{11 January 1987    Ported to LightSpeed Pascal by Owen Hartnett    }
{Ωhm Software Co., 163 Richard Drive, Tiverton, RI 02878        }

PROGRAM EventLog;

    USES
        TransSkelPas, TransDisplay;

    CONST

                    { declare zoom box part codes }

        inZoomIN = 7;
        inZoomOut = 8;

        maxButton = 14;

        helpTextRes = 1000;        { help text resource number }
        aboutAlrtRes = 1000;    { About... alert resource number }

                    { Menu resource numbers }

        fileMenuRes = 1000;
        editMenuRes = 1001;
        logMenuRes = 1002;

                    { Window resource numbers }

        LogWindRes = 1000;
        helpWindRes = 1001;
        SelectWindRes = 1002;

            { File menu item numbers }

        showLog = 1;    { make windows visible/bring to front }
        showHelp = 2;
        ShowSelect = 3;
        quit = 5;

                { Edit menu item numbers }

        undo = 1;
        cut = 3;
        copy = 4;
        paste = 5;
        clear = 6;

                { Log menu item numbers }

        logEvents = 1;        { whether events are logged }
        excludeLWind = 2;
        flushLog = 4;                { flush log output }
        wrapStyle = 6;            { word wrap or not }
        leftJust = 8;                { justification }
        centerJust = 9;
        rightJust = 10;
        small = 12;                { text size }
        medium = 13;
        large = 14;
        top = 16;                    { scroll home }
        bottom = 17;                { scroll to bottom }

    TYPE
        booleanPtr = ^Boolean;
        CtrlInfoPtr = ^CtrlInfoRec;
        CtrlInfoRec = RECORD
                loc : Point;        { upper left of control }
                title : Str255;        { control title }
                flagAddr : booleanPtr;    { associated boolean }
                ctrl : ControlHandle;        { associated control }
                subInfo : CtrlInfoPtr;    { subsidiary control }
            END;


    VAR
        selectWind, helpWind, logWind : WindowPtr;
            { event selection window }
            { help text window }
            { log output window }
        fileMenu, editMenu, logMenu : MenuHandle;
        reportEvents, excludeLog : Boolean;
        { report events or not }
        { exclude log window events or not }
        logFont, logSize : integer;
        logWrap, logJust : integer;
        rMouseDown, rMouseMods, rMouseWind, rMouseLoc : Boolean;
                            { event type selection flags }
        rMousePart, rMouseSys, rMouseUp, rKeyDown, rKDMods : Boolean;
        rAutoKey, rAKMods, rUpdate, rActivate, rDisk : Boolean;

{    Control information.  The last field is used to tell which controls}
{    are "owned" by another.  When the owner is unchecked, all the owned}
{    controls go dim.}

        ctrlInfo : ARRAY[0..maxButton] OF CtrlInfoRec;

{    Window that was in front last time checked    }

        lastFront : WindowPtr;
        h : Handle;

{    Do in Pascal what can be done in C as static initializations.  }

    PROCEDURE setupStuff;

    BEGIN
        rMouseDown := true;
        rMouseMods := false;
        rMouseWind := true;
        rMouseLoc := false;
        rMousePart := true;
        rMouseSys := false;
        rMouseUP := false;
        rKeyDown := true;
        rKDMods := false;
        rAutoKey := true;
        rAKMods := false;
        rUpdate := true;
        rActivate := true;
        rDisk := true;

        WITH ctrlInfo[0] DO
            BEGIN
                loc.v := 5;
                loc.h := 10;
                title := 'Mouse Down';
                flagAddr := @rMouseDown;
                ctrl := NIL;
                subInfo := NIL;
            END;

        WITH ctrlInfo[1] DO
            BEGIN
                loc.v := 25;
                loc.h := 30;
                title := 'Modifiers';
                flagAddr := @rMouseMods;
                ctrl := NIL;
                subInfo := @ctrlInfo[0];
            END;

        WITH ctrlInfo[2] DO
            BEGIN
                loc.v := 45;
                loc.h := 30;
                title := 'Window';
                flagAddr := @rMouseWind;
                ctrl := NIL;
                subInfo := @ctrlInfo[0];
            END;

        WITH ctrlInfo[3] DO
            BEGIN
                loc.v := 65;
                loc.h := 30;
                title := 'Location';
                flagAddr := @rMouseLoc;
                ctrl := NIL;
                subInfo := @ctrlInfo[0];
            END;

        WITH ctrlInfo[4] DO
            BEGIN
                loc.v := 85;
                loc.h := 30;
                title := 'Part Code';
                flagAddr := @rMousePart;
                ctrl := NIL;
                subInfo := @ctrlInfo[0];
            END;

        WITH ctrlInfo[5] DO
            BEGIN
                loc.v := 105;
                loc.h := 30;
                title := 'System Clicks';
                flagAddr := @rMouseSys;
                ctrl := NIL;
                subInfo := @ctrlInfo[0];
            END;

        WITH ctrlInfo[6] DO
            BEGIN
                loc.v := 125;
                loc.h := 10;
                title := 'Mouse Up';
                flagAddr := @rMouseUp;
                ctrl := NIL;
                subInfo := NIL;
            END;

        WITH ctrlInfo[7] DO
            BEGIN
                loc.v := 5;
                loc.h := 160;
                title := 'Key Down';
                flagAddr := @rKeyDown;
                ctrl := NIL;
                subInfo := NIL;
            END;

        WITH ctrlInfo[8] DO
            BEGIN
                loc.v := 25;
                loc.h := 180;
                title := 'Modifiers';
                flagAddr := @rKDMods;
                ctrl := NIL;
                subInfo := @ctrlInfo[7];
            END;

        WITH ctrlInfo[9] DO
            BEGIN
                loc.v := 45;
                loc.h := 180;
                title := 'AutoKey';
                flagAddr := @rAutoKey;
                ctrl := NIL;
                subInfo := NIL;
            END;

        WITH ctrlInfo[10] DO
            BEGIN
                loc.v := 65;
                loc.h := 180;
                title := 'Modifiers';
                flagAddr := @rAKMods;
                ctrl := NIL;
                subInfo := @ctrlInfo[9];
            END;

        WITH ctrlInfo[11] DO
            BEGIN
                loc.v := 85;
                loc.h := 160;
                title := 'Update';
                flagAddr := @rUpdate;
                ctrl := NIL;
                subInfo := NIL;
            END;

        WITH ctrlInfo[12] DO
            BEGIN
                loc.v := 105;
                loc.h := 160;
                title := 'Activate';
                flagAddr := @rActivate;
                ctrl := NIL;
                subInfo := NIL;
            END;

        WITH ctrlInfo[13] DO
            BEGIN
                loc.v := 125;
                loc.h := 160;
                title := 'Disk';
                flagAddr := @rDisk;
                ctrl := NIL;
                subInfo := NIL;
            END;

        lastFront := NIL;
    END;

{    Print information about a window.  If it's a window with a title,}
{    print the title.  Print whether it's a}
{    desk accessory window.}

    PROCEDURE WindowInfo (theWind : WindowPeek);

        VAR
            title : Str255;

    BEGIN
        GetWTitle(WindowPtr(theWind), title);
        IF title[0] <> char(0) THEN            { window has title }
            BEGIN
                DisplayChar(' ');
                DisplayString(title);
            END;
        IF theWind^.windowKind < 0 THEN
            DisplayString(' (DA)');
    END;

    PROCEDURE Modifiers (mods : integer);

    BEGIN
        DisplayString(' mods ($');
        DisplayHexInt(mods);
        DisplayChar(')');
    END;

    PROCEDURE MouseLoc (thePt : Point;
                                    thePort : GrafPtr);

        VAR
            savePort : GrafPtr;

    BEGIN
        GetPort(savePort);
        SetPort(thePort);
        GlobalToLocal(thePt);
        SetPort(savePort);
        IF rMouseLoc THEN
            BEGIN
                DisplaySTring(' loc (');
                DisplayInt(thePt.h);
                DisplayString(', ');
                DisplayInt(thePt.v);
                DisplayChar(')');
            END;
    END;

{    Mouse click.  Get the window that the click occurred in, and the}
{    part of the window.}

{    Make sure to get all the part codes!  (incl. zoom box stuff)}

    PROCEDURE ReportMouse (theEvent : EventRecord);

        VAR
            evtPt : Point;
            evtpart : integer;
            evtport : GrafPtr;

    BEGIN
        evtPt := theEvent.where;
        evtPart := FindWindow(evtPt, evtPort);
        IF NOT excludeLog OR (evtPort <> logWind) THEN
            BEGIN
                DisplayString('Mouse Click');
                CASE evtPart OF
                    inSysWindow :

{    Click in a desk accessory window.}

                        IF rMouseSys THEN
                            BEGIN
                                IF rMousePart THEN
                                    DisplayString(' in system window:');
                                IF rMouseWind THEN
                                    WindowInfo(WindowPeek(evtPort));
                                MouseLoc(evtPt, evtport);
                            END;
                    inDesk :

{    Click in desk top.}

                        IF rMousePart THEN
                            DisplayString(' in desktop');
                    inMenuBar :

{    Click in menu bar.}

                        IF rMousePart THEN
                            DisplayString(' in menu bar');
                    inGrow :

{    Click in grow box.}

                        BEGIN
                            IF rMousePart THEN
                                DisplayString(' in grow region:');
                            IF rMouseWind THEN
                                WindowInfo(WindowPeek(evtPort));
                            MouseLoc(evtPt, evtPort);
                        END;
                    inDrag :

{    Click in title bar.}

                        BEGIN
                            IF rMousePart THEN
                                DisplayString(' in drag region:');
                            IF rMouseWind THEN
                                WindowInfo(WindowPeek(evtPort));
                        END;
                    inGoAway :

{    Click in close box.}

                        BEGIN
                            IF rMousePart THEN
                                DisplayString(' in close box:');
                            IF rMouseWind THEN
                                WindowInfo(WindowPeek(evtPort));
                        END;
                    inZoomIn :

{    Click in zoom-in box.}

                        BEGIN
                            IF rMousePart THEN
                                DisplayString(' in zoom-in box:');
                            IF rMouseWind THEN
                                WindowInfo(WindowPeek(evtPort));
                        END;
                    inZoomOut :

{    Click in zoom-out box.}

                        BEGIN
                            IF rMousePart THEN
                                DisplayString(' in zoom-out box:');
                            IF rMouseWind THEN
                                WindowInfo(WindowPeek(evtPort));
                        END;
                    inContent :

{    Click in content region.}

{    (Might also check in in control, and if so, print control information)}

                        BEGIN
                            IF rMousePart THEN
                                DisplayString(' in content region:');
                            IF rMouseWind THEN
                                WindowInfo(WindowPeek(evtPort));
                            MouseLoc(evtPt, evtPort);
                        END;
                    OTHERWISE
                END;
                IF rMouseMods THEN
                    Modifiers(theEvent.modifiers);
                DisplayLn;
            END;
    END;

    PROCEDURE ReportKey (what : integer;
                                    c : char;
                                    mods : integer;
                                    modFlag : Boolean);
    BEGIN
        IF what = keyDown THEN
            DisplayString('Key Down: char "')
        ELSE
            DisplayString('Autokey: char"');
        DisplayChar(c);
        DisplayString('" ');
        IF modFlag THEN
            Modifiers(mods);
        Displayln;
    END;

    PROCEDURE ReportActivate (theWind : WindowPtr;
                                    mods : integer);

    BEGIN
        IF BitAnd(mods, activeFlag) <> 0 THEN
            DisplayString('Activate:')
        ELSE
            DisplayString('Deactivate:');
        WindowInfo(WindowPeek(theWind));
        DisplayLn;
    END;

    PROCEDURE ReportUpdate (theWind : WindowPtr);

    BEGIN
        DisplayString('Update:');
        WindowInfo(WindowPeek(theWind));
        Displayln;
    END;

{    General event logger}

    FUNCTION Logevent (theEvt : EventRecord) : Boolean;

        VAR
            theEvent : EventRecord;
            evtPt : Point;
            evtPort : GrafPtr;
            evtpart : integer;
            evtChar : char;
            evtMods : integer;
            r : Rect;

    BEGIN
        IF reportEvents = false THEN
            logevent := false
        ELSE
            BEGIN
                theEvent := theEvt;
                evtPt := theEvent.where;
                CASE theEvent.what OF
                    mouseDown :

{    Mouse click.}

                        IF rMouseDown THEN
                            ReportMouse(theEvent);
                    mouseUp :
                        IF rMouseUP THEN
                            BEGIN
                                DisplayString('Mouse Up');
                                Displayln;
                            END;
                    keyDown :

{    Key event.}

                        IF NOT (excludeLog AND (FrontWindow = logWind)) THEN
                            IF rKeyDown THEN
                                BEGIN
                                    evtChar := char(BitAnd(theEvent.message, charCodeMask));
                                    evtMods := theEvent.modifiers;
                                    ReportKey(keyDown, evtChar, evtMods, rKDMods);
                                END;
                    autoKey :
                        IF NOT (excludeLog AND (FrontWindow = logWind)) THEN
                            IF rKeyDown THEN
                                BEGIN
                                    evtChar := char(BitAnd(theEvent.message, charCodeMask));
                                    evtMods := theEvent.modifiers;
                                    ReportKey(keyDown, evtChar, evtMods, rKDMods);
                                END;
                    updateEvt :

{    Update a window.  If it's an update for the log window, invalidate}
{    it, because the message is written and will cause a scroll BEFORE}
{    the window actually gets updated.  This means that part of what}
{    needs redrawing will be scrolled out of the update region and won't}
{    be redrawn properly.  Invalidating the entire port is wasteful but}
{    makes sure the whole window can be drawn properly.}

                        BEGIN
                            IF WindowPtr(theEvent.message) = logWind THEN
                                BEGIN
                                    SetPort(logWind);
                                    InvalRect(logWind^.portRect);
                                END;
                            IF NOT (excludeLog AND (WindowPtr(theEvent.message) = logWind)) THEN
                                IF rUpdate THEN
                                    BEGIN
                                        ReportUpdate(WindowPtr(theEvent.message));
                                    END;
                        END;
                    activateEvt :

{    Activate or deactivate a window.}

                        IF NOT (excludeLog AND (WindowPtr(theEvent.message) = logWind)) THEN
                            IF rActivate THEN
                                BEGIN
                                    ReportActivate(WindowPtr(theEvent.message), theEvent.modifiers);
                                END;
                    diskEvt :

{    handle inserts of uninitialized disks}

                        IF rDisk THEN
                            BEGIN
                                DisplayString('Disk insertion');
                                IF HiWord(theEvent.message) <> noErr THEN
                                    DisplayString(' (needs initializing)');
                                Displayln;
                            END;
                END;
                logEvent := false;
            END;
    END;

{    Background procedure.  Check front window, reset edit menu if window}
{    changes from an application window to a non-application window.}
{    Disable the Edit menu whenever an application window is active,}
{    enable it otherwise.}
{    Also called whenever it is known that the active window has changed.}

    PROCEDURE CheckFront;

        VAR
            curWind : WindowPtr;
            theKind : integer;
            lastIsApp, curIsApp : Boolean;
            mypeek : WindowPeek;

    BEGIN
        curIsApp := false;
        lastIsApp := false;
        curWind := frontwindow;
        IF (IsDWindow(lastFront)) OR (lastFront = selectWind) THEN
            lastIsApp := true;
        IF (IsDWindow(curWind)) OR (curWind = selectWind) THEN
            curIsApp := true;
        IF lastFront <> curWind THEN
            BEGIN
                IF (IsDWindow(lastFront)) OR (lastFront = selectWind) THEN
                    lastIsApp := true;
                IF (IsDWindow(curWind)) OR (curWind = selectWind) THEN
                    curIsApp := true;
                IF lastIsApp <> curIsApp THEN
                    BEGIN
                        theKind := 0;
                        IF curWind <> NIL THEN
                            BEGIN
                                mypeek := windowpeek(curWind);
                                theKind := mypeek^.windowKind;
                            END;
                        IF (curWind = NIL) OR (theKind < 0) THEN    { no window or DA in front }
                            EnableItem(editMenu, 0)
                        ELSE
                            DisableItem(editMenu, 0);
                        DrawMenuBar;
                    END;
                lastFront := curWind;
            END;
    END;

{ ------------------------------------------------------------ }
{            Event Selection Window Handler Routines                }
{ ------------------------------------------------------------ }



{    Activate event procedure for both display windows and the checkbox}
{    window.}

    PROCEDURE Activate (active : Boolean);

    BEGIN
        CheckFront;
    END;

{    Update window.  This is easy, just draw the controls.}

    PROCEDURE Update (resized : Boolean);

    BEGIN
        DrawControls(selectwind);
    END;

{    Handle hits in check boxes:}
{    Toggle check box, sync the associated flag, and enable or disable}
{    any subsidiary check boxes accordingly.  (Subsidiaries have}
{    information in the control structure that points back to the owner}
{    check box.)}

    PROCEDURE Mouse (thePt : Point;
                                    t : longint;
                                    mods : integer);

        VAR
            ctl : ControlHandle;
            ci : CtrlInfoPtr;
            val : boolean;
            i : integer;
            genericPtr : BooleanPtr;

    BEGIN
        IF FindControl(thePt, selectWind, ctl) <> 0 THEN
            IF TrackControl(ctl, thePt, NIL) <> 0 THEN
                BEGIN
                    ci := CtrlInfoPtr(GetCRefcon(ctl));
                    val := NOT (GetCtlValue(ctl) <> 0);
                    genericPtr := BooleanPtr(ci^.flagAddr);
                    genericPtr^ := val;
                    SetCtlValue(ctl, integer(val));

            { enable/disable any subsidiaries }

                    FOR i := 0 TO maxButton - 1 DO
                        IF ctrlInfo[i].subInfo^.ctrl = ci^.ctrl THEN
                            IF val THEN
                                HiliteControl(ctrlInfo[i].ctrl, 0)
                            ELSE
                                HiliteControl(ctrlInfo[i].ctrl, 255);
                END
    END;

{    File menu handler}

    PROCEDURE DoFileMenu (item : integer);

    BEGIN
        CASE item OF
            showHelp :
                BEGIN
                    SelectWindow(helpWind);
                    ShowWindow(helpWind);
                END;
            showSelect :
                BEGIN
                    SelectWindow(selectWind);
                    ShowWindow(selectWind);
                END;
            showLog :
                BEGIN
                    SelectWindow(logWind);
                    ShowWindow(logWind);
                END;
            quit :
                SkelWhoa;
            OTHERWISE
        END;
    END;

{    Put the right check marks in the Log menu}

    PROCEDURE SetLogMenu;

    BEGIN
        CheckItem(logMenu, logEvents, reportEvents);
        CheckItem(logMenu, excludeLWind, excludeLog);
        CheckItem(logMenu, wrapStyle, logWrap >= 0);
        CheckItem(logMenu, leftJust, logJust = teJustLeft);
        CheckItem(logMenu, centerJust, logjust = teJustCenter);
        CheckItem(logMenu, rightJust, logJust = teJustRight);
        CheckItem(logMenu, small, logsize = 9);
        CheckItem(logMenu, medium, logsize = 12);
        CheckItem(logMenu, large, logSize = 24);
    END;

{    Set display style of log window}

    PROCEDURE SetStyle;

    BEGIN
        SetDWindowStyle(logWind, logFont, logSize, logWrap, logJust);
        SetLogMenu;
    END;

{    Log menu handler}

    PROCEDURE DoLogMenu (item : integer);

    BEGIN
        CASE item OF
            logEvents :
                BEGIN
                    reportEvents := NOT reportEvents;
                    SetLogMenu;
                END;
            excludeLWind :
                BEGIN
                    excludeLog := NOT excludeLog;
                    SetLogMenu;
                END;
            flushLog :
                FlushDWindow(logWind, longint(32767));
            wrapStyle :
                BEGIN
                    IF logWrap >= 0 THEN
                        logWrap := -1
                    ELSE
                        logWrap := 0;
                    SetStyle;
                END;
            leftJust :
                BEGIN
                    logJust := teJustLeft;
                    SetStyle;
                END;
            centerJust :
                BEGIN
                    logJust := teJustCenter;
                    SetStyle;
                END;
            rightJust :
                BEGIN
                    logJust := teJustRight;
                    SetStyle;
                END;
            small :
                BEGIN
                    logFont := monaco;
                    logSize := 9;
                    SetStyle;
                END;
            medium :
                BEGIN
                    logFont := systemFont;
                    logSize := 12;
                    SetStyle;
                END;
            large :
                BEGIN
                    logFont := geneva;
                    logSize := 24;
                    SetStyle;
                END;
            top :
                SetDWindowPos(logWind, 0);
            bottom :
                SetDWindowPos(logWind, 32767);
            OTHERWISE
        END;
    END;

{    Handle selection of About… item from Apple menu}

    PROCEDURE DoAbout;

        VAR
            ignore : integer;

    BEGIN
        ignore := Alert(aboutAlrtRes, NIL);
    END;

{    Dispose of event selection window (and controls)}

    PROCEDURE WClobber;

    BEGIN
        DisposeWindow(selectWind);
    END;

{    Create controls}

    PROCEDURE MakeControls (theWind : windowPtr);

        VAR
            i : integer;
            ci : CtrlInfoPtr;
            r : Rect;
            genericPtr : booleanPtr;

    BEGIN
        FOR i := 0 TO maxButton - 1 DO
            BEGIN
                ci := @ctrlInfo[i];
                SetRect(r, ci^.loc.h, ci^.loc.v, ci^.loc.h + StringWidth(ci^.title) + 30, ci^.loc.v + 20);
                genericPtr := ci^.flagAddr;
                ci^.ctrl := NewControl(theWind, r, ci^.title, true, integer(genericPtr^), 0, 1, checkBoxProc, longint(ci));
            END;
        ValidRect(theWind^.portRect);
    END;

BEGIN
    SetupStuff;
    SkelInit;
    TransDisplayInit;
    SkelApple('About EventLog...', @DoAbout);
    fileMenu := GetMenu(fileMenuRes);
    SkelMenu(fileMenu, @DoFileMenu, NIL);

    editMenu := GetMenu(editMenuRes);
    DisableItem(editmenu, 0);
    SkelMenu(editMenu, NIL, NIL);

    logMenu := GetMenu(logMenuRes);
    Skelmenu(logMenu, @DoLogmenu, NIL);

{    Create windows and install handlers.}

    SetDwindowNotify(NIL, @Activate);

    helpWind := GetNEwDWindow(helpWindRes, WindowPtr(-1));
    SetDWindowStyle(helpWind, 0, 0, 0, teJustLeft);

    h := GetREsource('TEXT', helpTextRes);    { read help text }
    HLock(h);                            { lock it and write to window }
    DisplayText(h^, GetHandleSize(h));
    HUnlock(h);
    ReleaseResource(h);                { done with it, so goodbye }
    SetDWindowPos(helpWind, 0);        { scroll back to top }
    ShowWindow(helpWind);

    logWind := GetNewDWindow(logWindRes, WindowPtr(-1));

    SkelEventHook(@logEvent);
    reportEvents := true;
    excludeLog := false;

    logFont := monaco;
    logSize := 9;
    logWrap := 0;
    logJust := teJustLeft;
    SetStyle;
    ShowWindow(logWind);

    selectWind := GetNewWindow(selectWindRes, NIL, WindowPtr(-1));

    SkelWindow(selectWind, @Mouse, NIL, @Update, @Activate, NIL, @WClobber, NIL, true);
        { the window }
        { mouse click handler }
        { key clicks are ignored }
        { window updating procedure }
        { window activate/deactivate procedure }
        { hide window }
        { window disposal procedure }
        { idle proc }
        { irrelevant }

    MakeControls(selectWind);

{    Process events until user quits,}
{    then clean up and exit}

    CheckFront;
    SkelBackground(@CheckFront);
    SkelMain;
    SkelClobber;
END.